home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
modula2f.zip
/
GRAPHICS.MOD
< prev
next >
Wrap
Text File
|
1992-05-01
|
4KB
|
213 lines
IMPLEMENTATION MODULE Graphics;
FROM SYSTEM IMPORT ASSEMBLER;
FROM MathLib0 IMPORT sqrt,entier,real;
FROM Text IMPORT WriteInt;
PROCEDURE SetCga320();
BEGIN
ASM
MOV AX,4
INT 10H
END;
END SetCga320;
PROCEDURE SetCgaMono();
BEGIN
ASM
MOV AX,6
INT 10H
END;
END SetCgaMono;
PROCEDURE SetEga320();
BEGIN
ASM
MOV AX,13
INT 10H
END;
END SetEga320;
PROCEDURE SetEga640();
BEGIN
ASM
MOV AX,14
INT 10H
END;
END SetEga640;
PROCEDURE SetPlus();
BEGIN
ASM
MOV AX,16
INT 10H
END;
END SetPlus;
PROCEDURE SetTandy();
BEGIN
ASM
MOV AH,5
MOV AL,80H
INT 10H
DEC BH
DEC BL
MOV AH,5
MOV AL,83H
INT 10H
MOV AX,9
INT 10H
END;
END SetTandy;
PROCEDURE SetBackground(color:INTEGER);
BEGIN
color:=color MOD 16;
ASM
MOV AH,11
XOR BH,BH
MOV BL,color
INT 10H
END;
END SetBackground;
PROCEDURE Dot(color,xloc,yloc:INTEGER);
BEGIN
color:=color MOD 16;
ASM
MOV CX,xloc
MOV DX,yloc
MOV AL,color
MOV AH,12
INT 10H
END;
END Dot;
PROCEDURE Box(color,x1,y1,x2,y2:INTEGER);
VAR i:INTEGER;
BEGIN
IF x1>x2 THEN
i:=x1;
x1:=x2;
x2:=i;
END;
IF y1>y2 THEN
i:=y1;
y1:=y2;
y2:=i;
END;
ASM
MOV AL,color
MOV AH,12
MOV CX,x1
MOV DX,y1
INT 10H
ULOP: INC CX
INT 10H
CMP CX,x2
JL ULOP
RLOP: INC DX
INT 10H
CMP DX,y2
JL RLOP
DLOP: DEC CX
INT 10H
CMP CX,x1
JG DLOP
LLOP: DEC DX
INT 10H
CMP DX,y1
JG LLOP
END;
END Box;
PROCEDURE SQR(i:INTEGER):INTEGER;
VAR a,b,d:INTEGER;
BEGIN
a:=i DIV 2;
b:=(a+i DIV a) DIV 2;
d:=b-a;
WHILE (d > 10) OR (d < -10) DO
a:=b;
b:=(a+i DIV a) DIV 2;
d:=b-a;
END; (* while *)
RETURN b;
END SQR;
PROCEDURE Circle(color,xloc,yloc,rad:INTEGER);
VAR i,j,max:INTEGER;
BEGIN
max:=entier((sqrt(2.0)*real(rad))/2.0);
FOR i:=0 TO max DO
j:=SQR(rad*rad-i*i);
ASM
MOV CX,xloc
ADD CX,i
MOV DX,yloc
ADD DX,j
MOV AL,color
MOV AH,12
INT 10H
SUB CX,i
SUB CX,i
INT 10H
SUB DX,j
SUB DX,j
INT 10H
ADD CX,i
ADD CX,i
INT 10H
MOV CX,xloc
ADD CX,j
MOV DX,yloc
ADD DX,i
INT 10H
SUB CX,j
SUB CX,j
INT 10H
SUB DX,i
SUB DX,i
INT 10H
ADD CX,j
ADD CX,j
INT 10H
END;
END;
END Circle;
PROCEDURE Look(xloc,yloc:INTEGER):INTEGER;
VAR color:INTEGER;
BEGIN
color:=0;
ASM
MOV CX,xloc
MOV DX,yloc
MOV AH,13
INT 10H
MOV color,AL
END;
RETURN color
END Look;
PROCEDURE Clear();
BEGIN
ASM
XOR BH,BH
MOV BL,7
MOV CX,80
XOR DX,DX
LOP: MOV AH,2
INT 10H
MOV AL,32
MOV AH,9
INT 10H
INC DH
CMP DH,25
JNE LOP
END;
END Clear;
END Graphics.